/*
 *	Plurals
 *
 *	Author:	S.C.Merrall
 *
 *	File:	mp_lists.m
 *
 *	Contents:	
 *
 *	Description:	A set of functions for creating and manipulatinh
 *			cons cells in the usual lisp fashion
 *
 *	Change History:
 *
 *	Date   Name Comment
 *    -------- ---- -------
 *    23:04:91 SCM  Created
 *
 */

#include <mpl.h>
#include <stdio.h>

#include "constant.h"

#include "mp_object.h"
#include "mp_debug_off.h"
#include "mp_type.h"
#include "mp_mem_mgmt.h"
#include "mp_gc.h"

typedef struct cons_cell_ {natural car;
			   natural cdr;
			 } cons_cell;

/*----------------------------------------------------------------------------*
 * Function   : cons
 *
 * Parameters : MP_PluralHeap MPPH_car:	MasPar Plural Heap handles on car and
 *		MP_PluralHeap MPPH_cdr:	cdr components of cons cell.
 *		MP_PluralHeap MPPH_cell:	Resulting cons cell.
 *
 * Description:    Allocates a cons cell and sets the car and cdr to be 
 *		those values given.
 *
 * Result     : int:	FAIL/SUCCESS
 *---------------------------------------------------------------------------*/

#ifdef __STDC__

int cons( MP_PluralHeap MPPH_car, MPPH_cdr, MPPH_cell )

#else 

int cons( MPPH_car, MPPH_cdr, MPPH_cell )

MP_PluralHeap MPPH_car;
MP_PluralHeap MPPH_cdr;
MP_PluralHeap MPPH_cell;

#endif

{
  plural cons_cell *plural new_cell;
  plural natural temp;
  MP_PluralHeap MPPH_temp;
DBG_CALL("mp_cons");
DBG_ARGS(DBG_PARG("MPPH_car","%x ",MPPH_car);DBG_PARG("\nMPPH_cdr","%x ",MPPH_cdr);DBG_PARG("\nMPPH_cell","%x ",MPPH_cell));

  /* Allocate space for cons cell */

  OA_to_offsets(MPPH_temp) = &temp;

  if (mp_alloc((plural int) MP_CONS, (plural int) 1, MPPH_temp) == FAIL) {

DBG_FAIL(fprintf(dbg,"FAIL: Unable to allocate space"));
    return FAIL;
  }

/*  new_cell = (plural cons_cell *plural) OA_data(MPPH_temp); */
/*  new_cell->car = OA_offsets(MPPH_car); */

  *((plural natural *plural) OA_data(MPPH_temp)) = OA_offsets(MPPH_car);

DEBUG(DBG_PARG("ps[2589]","%d ",plural_memory[2589]));	

  
  
  *(((plural natural *plural) OA_data(MPPH_temp)) + 1) = (plural natural) OA_offsets(MPPH_cdr);

DEBUG(DBG_PARG("*","%d ",*(((plural natural *plural) OA_data(MPPH_temp))+1)));
DEBUG(DBG_PARG("ps[2589]","%d ",plural_memory[2589]));	
DEBUG(DBG_PARG("hs[2589]","%d ",heap_memory[2589]));
  OA_offsets(MPPH_cell) = OA_offsets(MPPH_temp);

DBG_EXIT(fprintf(dbg,"SUCCESS"));
  return SUCCESS;
}

/*----------------------------------------------------------------------------*
 * Function   : car
 *
 * Parameters : MP_PluralHeap MPPH_cell:	Maspar Plural Heap handles on cons cell
 *					(we hope)
 *		MP_PluralHeap MPPH_car:	Maspar Plural Heap handle on car
 *					
 * Description:    Returns car of cons pairs in parallel.
 *
 * Result     : int:	SUCCESS/FAIL
 *---------------------------------------------------------------------------*/

#ifdef __STDC__

int car( MP_PluralHeap MPPH_cell, MP_PluralHeap MPPH_car )

#else

int car ( MPPH_cell, MPPH_car )

MP_PluralHeap MPPH_cell;
MP_PluralHeap MPPH_car;

#endif

{
  plural cons_cell *plural cell;
DBG_CALL("car");
DBG_ARGS(fprintf(dbg,"MPPH_cell=%04x, MPPH_car=%04x",MPPH_cell,MPPH_car));

  cell = (plural cons_cell *plural) OA_data(MPPH_cell);

  /* Check these are all cons cells */

  if (globalor (OA_info(MPPH_cell) != MP_CONS)) {

DBG_EXIT(fprintf(dbg,"FAIL: Not all of these are cons cells"));
    return FAIL;
  }

  OA_offsets(MPPH_car) = cell->car;
  
DBG_EXIT(fprintf(dbg,"SUCCESS"));
  return SUCCESS;
}

/*----------------------------------------------------------------------------*
 * Function   : car
 *
 * Parameters : MP_PluralHeap MPPH_cell:	Maspar Plural Heap handles on cons cell
 *					(we hope)
 *		MP_PluralHeap MPPH_cdr:	Maspar Plural Heap handle on cdr
 *					
 * Description:    Returns cdr of cons pairs in parallel.
 *
 * Result     : int:	SUCCESS/FAIL
 *---------------------------------------------------------------------------*/

#ifdef __STDC__

int cdr( MP_PluralHeap MPPH_cell, MP_PluralHeap MPPH_cdr )

#else

int cdr ( MPPH_cell, MPPH_cdr )

MP_PluralHeap MPPH_cell;
MP_PluralHeap MPPH_cdr;

#endif

{
  plural cons_cell *plural cell;
DBG_CALL("cdr");
DBG_ARGS(DBG_PARG("MPPH_cell","%04x ",MPPH_cell);
	 DBG_PARG(", MPPH_cdr","%04x ",MPPH_cdr));

  cell = (plural cons_cell *plural) OA_data(MPPH_cell);

  /* Check these are all cons cells */

  if (globalor (OA_info(MPPH_cell) != MP_CONS)) {

DBG_EXIT(fprintf(dbg,"FAIL: Not all of these are cons cells"));
    return FAIL;
  }

  OA_offsets(MPPH_cdr) = cell->cdr;
  
DBG_EXIT(fprintf(dbg,"SUCCESS"));
  return SUCCESS;
}

/*----------------------------------------------------------------------------*
 * Function   : rplac_a
 *
 * Parameters : MP_PluralHeap MPPH_cell:	cell to have car changed
 *		object MPP_new_car:	new value of car
 *
 * Description: Takes a cons cell and changes the existing value of car to
 *		the given new value
 *
 * Result     : int SUCCESS/FAIL
 *---------------------------------------------------------------------------*/

#ifdef __STDC__

int rplac_a( MP_PluralHeap MPPH_cell, MP_PluralHeap MPPH_new_car )

#else

int rplac_a( MPPH_cell, MPPH_new_car )

MP_PluralHeap MPPH_cell;
MP_PluralHeap MPPH_new_car;

#endif

{
  plural cons_cell *plural cell;
DBG_CALL("rplac_a");
DBG_ARGS(fprintf(dbg,"MPPH_cell=%04x, MPPH_new_car=%04x",MPPH_cell,MPPH_new_car));

  cell = (plural cons_cell *plural) OA_data(MPPH_cell);

  /* Check these are all cons cells */

  if (globalor (OA_info(MPPH_cell) != MP_CONS)) {

DBG_EXIT(fprintf(dbg,"FAIL: Not all of these are cons cells"));
    return FAIL;
  }

  cell->car = OA_offsets(MPPH_new_car);

DBG_EXIT(fprintf(dbg,"SUCCESS"));
  return SUCCESS;
}

/*----------------------------------------------------------------------------*
 * Function   : rplac_d
 *
 * Parameters : MP_PluralHeap MPPH_cell:	cell to have cdr changed
 *		object MPP_new_cdr:	new value of cdr
 *
 * Description: Takes a cons cell and changes the existing value of cdr to
 *		the given new value
 *
 * Result     : int SUCCESS/FAIL
 *---------------------------------------------------------------------------*/

#ifdef __STDC__

int rplac_d( MP_PluralHeap MPPH_cell, MP_PluralHeap MPPH_new_cdr )

#else

int rplac_d( MPPH_cell, MPPH_new_cdr )

MP_PluralHeap MPPH_cell;
MP_PluralHeap MPPH_new_cdr;

#endif

{
  plural cons_cell *plural cell;
DBG_CALL("rplac_d");
DBG_ARGS(fprintf(dbg,"MPPH_cell=%04x, MPPH_new_cdr=%04x",MPPH_cell,MPPH_new_cdr));

  cell = (plural cons_cell *plural) OA_data(MPPH_cell);

  /* Check these are all cons cells */

  if (globalor (OA_info(MPPH_cell) != MP_CONS)) {

DBG_EXIT(fprintf(dbg,"FAIL: Not all of these are cons cells"));
    return FAIL;
  }

  cell->cdr = OA_offsets(MPPH_new_cdr);

DBG_EXIT(fprintf(dbg,"SUCCESS"));
  return SUCCESS;
}
